home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / tclStruct1.2.tar.gz / tclStruct1.2.tar / tclStruct1.2 / ex / fslsfonts.tcl < prev    next >
Text File  |  1995-10-17  |  4KB  |  142 lines
  1. #!/usr/local/bin/tclsh
  2. #    "@(#)tclStruct:fslsfonts.tcl    1.1    95/10/17"
  3. #
  4. # Written by Matthew Costello
  5. # (c) 1995 AT&T Global Information Solutions, Dayton Ohio USA
  6. #
  7. # See the file "license.terms" for information on usage and
  8. # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9.  
  10. #    fslsfonts.tcl
  11. # This is a (partial) implementation of the fslsfonts(1)
  12. # command:
  13. #    Fslsfonts lists the fonts that match the given pattern.  The
  14. #    wildcard character "*" may be used to match any sequence of
  15. #    characters (including none), and "?" to match any single
  16. #    character.  If no pattern is given, "*" is assumed.
  17.  
  18.  
  19. load libdplite.so Tdp
  20. load libtclStruct.so Struct
  21.  
  22. # Process command line arguments
  23. catch {set fontserver $env(FONTSERVER)}
  24. set fontpattern {*}
  25. if {[string compare [lindex $argv 0] "-server"] == 0} {
  26.     set fontserver [lindex $argv 1]
  27.     incr argc -2
  28. }
  29. if {[string compare [lindex $argv 0] "-fn"] == 0} {
  30.     set fontpattern [lindex $argv 1]
  31.     incr argc -2
  32. }
  33. if {$argc != 0} {
  34.     puts stderr "Usage: $argv0 \[-server servername\] \[-fn pattern\]"
  35.     exit 2
  36. }
  37.  
  38. # Determine where the font server is located
  39. if {[catch {set fs [split $fontserver : ]}]} {
  40.     puts stderr "$argv0: FONTSERVER not set"
  41.     exit 2
  42. }
  43. if {[llength $fs] != 2} {
  44.     puts stderr "$argv0: FONTSERVER should have format 'server:port'"
  45.     exit 2
  46. }
  47.  
  48. # Connect to the font server
  49. set fd [eval dp_connect $fs]
  50. set fd [lindex $fd 0]
  51.  
  52. # struct_info debug +all
  53. struct_typedef fs_open_connection_t {struct
  54.     align 1
  55.     {char    byte-order}
  56.     {ubyte    num-auths}
  57.     {ushort    client-major-protocol-version}
  58.     {ushort    client-minor-protocol-version}
  59.     {ushort    auth-len}
  60.     {ubyte*0    authorization-protocols}
  61.     align 4
  62. }
  63. struct_typedef fs_open_connection_setup_t {struct
  64.     {ushort    status}
  65.     {ushort    server-major-protocol-version}
  66.     {ushort server-minor-protocol-version}
  67.     {ubyte    num_alternates}
  68.     {ubyte    auth_index}
  69.     {ushort    alternate_len}
  70.     {ushort    auth_len}
  71.     {ubyte*0    data}
  72. }
  73. struct_typedef fs_open_connection_setup2_t {struct
  74.     {uint    remaining-length}
  75.     {ushort    maximum-request-length}
  76.     {ushort    vendor-length}
  77.     {uint    release-number}
  78.     {char*0    vendor}
  79. }
  80.  
  81. struct_new open_connection fs_open_connection_t(0)
  82. set open_connection() { l 0 2 0 }
  83. struct_write -unbuffered $fd open_connection
  84.  
  85.  
  86. struct_new connection_setup fs_open_connection_setup_t(0)
  87. set rlen [struct_read -unbuffered $fd connection_setup]
  88.  
  89. struct_new connection_accept fs_open_connection_setup2_t(0)
  90. set rlen [struct_read -unbuffered $fd connection_accept]
  91.  
  92.  
  93. struct_typedef vendor_name1_t char*$connection_accept(vendor-length)
  94. struct_typedef vendor_name2_t {struct {vendor_name1_t vendor_name} align 4}
  95. struct_new vendor_name vendor_name2_t
  96. set rlen [struct_read -unbuffered $fd vendor_name]
  97.  
  98. # Getting font list
  99. struct_typedef fs_list_fonts_t {struct
  100.     {ubyte    major-opcode}
  101.     {ubyte    minor_opcode}
  102.     {ushort    length}
  103.     {uint    max-names}
  104.     {ushort    pattern-length}
  105.     {ushort    {}}
  106.     {char*0 pattern}
  107.     align 4
  108. }
  109. struct_new list_fonts fs_list_fonts_t([string length $fontpattern])
  110. set list_fonts() "13 0 4 99999 [string length $fontpattern] $fontpattern"
  111. set list_fonts(length) [expr [struct_info sizeof list_fonts] / 4]
  112. struct_write -unbuffered $fd list_fonts
  113.  
  114. struct_typedef fs_list_fonts_reply_t {struct
  115.     {ubyte    type}
  116.     {ubyte    pad}
  117.     {ushort    sequence-number}
  118.     {uint    length}
  119.     {uint    num-replies}
  120.     {uint    num-fonts}
  121. }
  122.     # LISTofSTRNAME
  123. struct_new list_fonts_reply fs_list_fonts_reply_t
  124. set rlen [struct_read -unbuffered $fd list_fonts_reply]
  125. #puts "num-replies:       $list_fonts_reply(num-replies)"
  126. #puts "number of fonts:   $list_fonts_reply(num-fonts)"
  127.  
  128. catch {unset buffer}
  129. struct_new buffer byte*[expr ( $list_fonts_reply(length) - 4 ) * 4]
  130. set rlen [struct_read -unbuffered $fd buffer]
  131. puts "Length of string buffer rlen = $rlen (size = [struct_info sizeof buffer])"
  132. for {set i 0 ; set count $list_fonts_reply(num-fonts)} {$count > 0} {incr count -1} {
  133.     set len $buffer($i._ubyte_)
  134. #    puts "i = $i, len = $len"
  135.     incr i 1
  136. #    puts "\tsizeof buffer(_char_.$i-[expr $i + $len]) = [struct_info object buffer(_char_.$i-[expr $i + $len]) size]"
  137.     puts "$buffer(_char_.$i-[expr $i + $len])"
  138.     incr i $len
  139. }
  140.  
  141. close $fd
  142.